home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyCollections.p < prev    next >
Encoding:
Text File  |  1996-10-10  |  21.6 KB  |  865 lines  |  [TEXT/CWIE]
  1. unit MyCollections;
  2.  
  3. interface
  4.  
  5.     uses
  6.         Types;
  7.  
  8.     const
  9.         no_tag = 0;
  10.  
  11.     type
  12.         PermuteArray = array[1..8000] of integer;
  13.         PermuteArrayPtr = ^PermuteArray;
  14.  
  15.     type
  16.         tagType = OSType;
  17.         indexType = longint;
  18.         Collection = object
  19.                 error: OSErr; { PUBLIC }
  20.                 safeget: boolean; { PUBLIC }
  21.                 testheap: boolean; { PUBLIC }
  22.  
  23.                 data: Handle; { PRIVATE }
  24.                 size: longint; { PRIVATE }
  25.                 cnt: indexType; { PRIVATE }
  26.                 fixed, tagged: boolean; { PRIVATE }
  27.                 lensize, tagsize: longint; { PRIVATE }
  28.                 searchindex: indexType; { PRIVATE }
  29.                 searchtag: tagType; { PRIVATE }
  30.                 cacheoffset: longint; { PRIVATE }
  31.                 cachelen: longint; { PRIVATE }
  32.                 cacheindex: indexType; { PRIVATE }
  33.  
  34.                 procedure Create (siz: longint; fix, tag: boolean);
  35.                 procedure CreateFromHandle (d: Handle);
  36.                 procedure Destroy;
  37.                 procedure SetDataHandle (d: Handle);
  38.                 function GetDataHandle: Handle;
  39.                 procedure Reset;
  40.  
  41.                 function Count: indexType;
  42.  
  43.                 function GetTag (index: indexType): tagType;
  44.                 function GetIndex (tag: tagType): indexType;
  45.  
  46.                 procedure SetTag (index: indexType; tag: tagType);
  47.  
  48.                 function Exists (index: indexType): boolean;
  49.                 function ExistsTag (tag: {univ }tagType): boolean;
  50.  
  51.                 function Info (index: indexType; var len: longint): boolean;
  52.                 function InfoTag (tag: {univ } tagType; var len: longint): boolean;
  53.  
  54.                 procedure Delete (index: indexType);
  55.                 procedure DeleteTag (tag: {univ } tagType);
  56.  
  57.                 procedure InsertBefore (index: indexType);
  58.  
  59.                 procedure Permute (map: PermuteArrayPtr);
  60.  
  61.                 procedure AddBoolean (b: boolean);
  62.                 procedure AddTagBoolean (tag: {univ } tagType; b: boolean);
  63.                 procedure AddLong (n: univ longint);
  64.                 procedure AddTagLong (tag: {univ } tagType; n: univ longint);
  65.                 procedure AddString (const s: Str255);
  66.                 procedure AddTagString (tag: {univ } tagType; const s: Str255);
  67.                 procedure AddData (p: Ptr; len: longint);
  68.                 procedure AddTagData (tag: {univ } tagType; p: Ptr; len: longint);
  69.                 procedure AddItem (p: Ptr);
  70.                 procedure AddTagItem (tag: {univ } tagType; p: Ptr);
  71.  
  72.                 procedure SetBoolean (index: indexType; b: boolean);
  73.                 procedure SetTagBoolean (tag: {univ } tagType; b: boolean);
  74.                 procedure SetLong (index: indexType; n: univ longint);
  75.                 procedure SetTagLong (tag: {univ } tagType; n: univ longint);
  76.                 procedure SetString (index: indexType; const s: Str255);
  77.                 procedure SetTagString (tag: {univ } tagType; const s: Str255);
  78.                 procedure SetData (index: indexType; p: Ptr; len: longint);
  79.                 procedure SetTagData (tag: {univ } tagType; p: Ptr; len: longint);
  80.                 procedure SetItem (index: indexType; p: Ptr);
  81.                 procedure SetTagItem (tag: {univ } tagType; p: Ptr);
  82.  
  83.                 function GetBoolean (index: indexType): boolean;
  84.                 function GetTagBoolean (tag: {univ } tagType): boolean;
  85.                 procedure GetLong (index: indexType; var l: univ longint);
  86.                 procedure GetTagLong (tag: {univ } tagType; var l: univ longint);
  87.                 function GetString (index: indexType): Str255;
  88.                 function GetTagString (tag: {univ } tagType): Str255;
  89.                 procedure GetData (index: indexType; p: Ptr; len: longint);
  90.                 procedure GetTagData (tag: {univ } tagType; p: Ptr; len: longint);
  91.                 procedure GetItem (index: indexType; p: Ptr);
  92.                 procedure GetTagItem (tag: {univ } tagType; p: Ptr);
  93.  
  94.                 procedure InvalidateCache;
  95.                 function GetOffset (index: indexType; var offset: longint; var len: longint): boolean; { PRIVATE }
  96.                 function GetTagOffset (tag: {univ } tagType; var offset: longint; var len: longint; var index: indexType; test: boolean): boolean; { PRIVATE }
  97.                 procedure AddChunk (tag: tagType; p: Ptr; len: longint); { PRIVATE }
  98.                 procedure SetChunk (offset, l: longint; tag: tagType; p: Ptr; len: longint); { PRIVATE }
  99.                 procedure SetChunkIndex (index: indexType; p: Ptr; len: longint); { PRIVATE }
  100.                 procedure SetChunkTag (tag: tagType; p: Ptr; len: longint); { PRIVATE }
  101.                 procedure GetChunkIndex (index: indexType; len: longint; p: Ptr); { PRIVATE }
  102.                 procedure GetChunkTag (tag: tagType; len: longint; p: Ptr); { PRIVATE }
  103.             end;
  104.  
  105.     procedure HackUpdateHandleToCollection (data: Handle);
  106.  
  107. implementation
  108.  
  109.     uses
  110.         MyAssertions, MyUtils, MyTypes, MyMemory;
  111.  
  112. { Format is saved in prefs files, so it must not change! }
  113.  
  114.     const
  115.         lsize = 4;
  116.         magic_version = $12345678;
  117.         fixed_bit = 16;
  118.         tagged_bit = 0;
  119.         safeget_bit = 1;
  120.  
  121. {$PUSH}
  122. {$ALIGN MAC68K}
  123.  
  124.     type
  125.         header = record
  126.                 version: longint;
  127.                 size: longint;
  128.                 cnt: indexType;
  129.                 flags: longint;
  130.                 space: longint;
  131.             end;
  132.         headerPtr = ^header;
  133.         headerHandle = ^headerPtr;
  134.  
  135. {$ALIGN RESET}
  136. {$POP}
  137.  
  138. { Data format: }
  139. { header}
  140. { [tag (lsize)] [length (lsize)] data }
  141.  
  142.     function LongAtPtr (p: univ LongIntPtr): longint;
  143. {$IFC not GENERATINGPOWERPC}
  144.     inline
  145.         $205F, $224F, $12D8, $12D8, $12D8, $12D8;
  146. { move.l (sp)+,a0 move.l sp,a1, 4*move.b (a0)+,(a1)+ }
  147. {$ELSEC}
  148.     begin
  149.         LongAtPtr:=p^;
  150.     end;
  151. {$ENDC}
  152.  
  153.     function TagAtPtr (p: univ LongIntPtr): tagType;
  154. {$IFC not GENERATINGPOWERPC}
  155.     inline
  156.         $205F, $224F, $12D8, $12D8, $12D8, $12D8;
  157. { move.l (sp)+,a0 move.l sp,a1, 4*move.b (a0)+,(a1)+ }
  158. {$ELSEC}
  159.     begin
  160.         TagAtPtr:=tagType(p^);
  161.     end;
  162. {$ENDC}
  163.  
  164.     function EqualTag(t1, t2: OSType): Boolean;
  165.     begin
  166.         EqualTag := longint(t1) = longint(t2);
  167.     end;
  168.  
  169.     procedure HackUpdateHandleToCollection (data: Handle);
  170.         var
  171.             h: header;
  172.             pos: longint;
  173.             size: longint;
  174.             junk: OSErr;
  175.     begin
  176.         if (GetHandleSize(data) < SizeOf(header)) | (headerHandle(data)^^.version <> magic_version) then begin
  177.             h.version := magic_version;
  178.             h.size := -1;
  179.             h.flags := 0;
  180.             BSET(h.flags, tagged_bit);
  181.             BSET(h.flags, safeget_bit);
  182.             h.space := 0;
  183.             h.cnt := 0;
  184.             pos := 0;
  185.             while (pos >= 0) & (pos <= GetHandleSize(data) - 8) do begin
  186.                 h.cnt := h.cnt + 1;
  187.                 size := LongAtPtr(Ptr(ord(data^) + lsize));
  188.                 if (size < 0) | (size > 1000) then begin
  189.                     pos := -1;
  190.                 end else begin
  191.                     pos := pos + 8 + size;
  192.                 end;
  193.             end;
  194.             if pos <> GetHandleSize(data) then begin
  195.                 SetHandleSize(data, 0);
  196.                 h.cnt := 0;
  197.             end;
  198.             junk := MMungerInsert(data, 0, @h, SizeOf(h));
  199.         end;
  200.     end;
  201.  
  202.     procedure Collection.Create (siz: longint; fix, tag: boolean);
  203.         var
  204.             junk: OSErr;
  205.     begin
  206.         HLock(Handle(self));
  207.         junk := MNewHandle( data, SizeOf(header) );
  208.         size := siz;
  209.         fixed := fix;
  210.         tagged := tag;
  211.         safeget := false;
  212.         testheap := false;
  213.         lensize := lsize * ord(not fixed);
  214.         tagsize := lsize * ord(tagged);
  215.         Reset;
  216.     end;
  217.  
  218.     procedure Collection.Destroy;
  219.     begin
  220.         MDisposeHandle(data);
  221.         dispose(self);
  222.     end;
  223.  
  224.     function Collection.GetDataHandle: Handle;
  225.         var
  226.             flags: longint;
  227.     begin
  228.         headerHandle(data)^^.version := magic_version;
  229.         headerHandle(data)^^.size := size;
  230.         headerHandle(data)^^.cnt := cnt;
  231.         flags := 0;
  232.         if fixed then begin
  233.             BSET(flags, fixed_bit);
  234.         end;
  235.         if tagged then begin
  236.             BSET(flags, tagged_bit);
  237.         end;
  238.         if safeget then begin
  239.             BSET(flags, safeget_bit);
  240.         end;
  241.         headerHandle(data)^^.flags := flags;
  242.         headerHandle(data)^^.space := 0;
  243.         GetDataHandle := data;
  244.     end;
  245.  
  246.     procedure Collection.SetDataHandle (d: Handle);
  247.         var
  248.             flags: longint;
  249.     begin
  250.         if headerHandle(d)^^.version = magic_version then begin
  251.             MDisposeHandle(data);
  252.             data := d;
  253.             error := noErr;
  254.             size := headerHandle(data)^^.size;
  255.             cnt := headerHandle(data)^^.cnt;
  256.             flags := headerHandle(data)^^.flags;
  257.             fixed := BTST(flags, fixed_bit);
  258.             tagged := BTST(flags, tagged_bit);
  259.             safeget := BTST(flags, safeget_bit);
  260.             testheap := false;
  261.             lensize := lsize * ord(not fixed);
  262.             tagsize := lsize * ord(tagged);
  263.             InvalidateCache;
  264.         end else begin
  265.             Reset;
  266.             error := -1;
  267.         end;
  268.     end;
  269.  
  270.     procedure Collection.CreateFromHandle (d: Handle);
  271.         var
  272.             junk: OSErr;
  273.     begin
  274.         junk := MNewHandle( data, SizeOf(header) );
  275.         SetDataHandle(d);
  276.     end;
  277.     
  278.     procedure Collection.Reset;
  279.     begin
  280.         error := noErr;
  281.         cnt := 0;
  282.         SetHandleSize(data, SizeOf(header));
  283.         InvalidateCache;
  284.     end;
  285.  
  286.     procedure Collection.InvalidateCache;
  287.     begin
  288.         cacheoffset := -1;
  289.     end;
  290.  
  291.     procedure Collection.Permute (map: PermuteArrayPtr);
  292.         type
  293.             LongArray = array[1..8000] of longint;
  294.             LongArrayPtr = ^LongArray;
  295.         var
  296.             i, j, k: integer;
  297.             offset, src, len, handlesize: longint;
  298.             dummy: boolean;
  299.             newdata: Handle;
  300.             offsetptr: LongArrayPtr;
  301.             tmpmap: PermuteArrayPtr;
  302.             err, junk: OSErr;
  303.     begin
  304.         handlesize := GetHandleSize(data);
  305.         newdata := TempNewHandle(handlesize, err);
  306.         if newdata = nil then begin
  307.             junk := MNewHandle( newdata, handlesize );
  308.         end;
  309.         offsetptr := nil;
  310.         if newdata <> nil then begin
  311.             err := MNewPtr(offsetptr, longint(cnt) * 4);
  312.         end;
  313.         if offsetptr <> nil then begin
  314.             offset := SizeOf(header) + tagsize;
  315.             for i := 1 to cnt do begin
  316.                 offsetptr^[i] := offset - tagsize;
  317.                 if fixed then begin
  318.                     offset := offset + size + tagsize;
  319.                 end else begin
  320.                     offset := offset + lsize + LongAtPtr(Ptr(ord(data^) + offset)) + tagsize; { Point to next length }
  321.                 end;
  322.             end;
  323.             offset := SizeOf(header);
  324.             len := size + tagsize + lensize;
  325.             for i := 1 to cnt do begin
  326.                 src := offsetptr^[map^[i]];
  327.                 if not fixed then begin
  328.                     len := tagsize + LongAtPtr(Ptr(ord(data^) + src + tagsize)) + lensize;
  329.                 end;
  330.                 BlockMoveData(Ptr(ord(data^) + src), Ptr(ord(newdata^) + offset), len);
  331.                 offset := offset + len;
  332.             end;
  333.             Assert(offset = handlesize);
  334.             BlockMoveData(newdata^, data^, handlesize);
  335.             MDisposePtr(offsetptr);
  336.             MDisposeHandle(newdata);
  337.         end else begin
  338.             MDisposeHandle(newdata); { nil safe }
  339.             err := MNewPtr( tmpmap, longint(cnt) * SizeOf(map^[1]) );
  340.             if err = noErr then begin
  341.                 BlockMoveData( map, tmpmap, GetPtrSize( Ptr(tmpmap) ) );
  342.                 for i := 1 to cnt do begin
  343.                     k := tmpmap^[i];
  344.                     cacheoffset := -1;
  345.                     dummy := GetOffset(k, offset, len);
  346.                     Assert(dummy);
  347.                     offset := offset - tagsize - lensize;
  348.                     len := len + tagsize + lensize;
  349.                     SetHandleSize(data, handlesize + len);
  350.                     Assert(MemError = noErr);
  351.                     HLock(data);
  352.                     BlockMoveData(Ptr(ord(data^) + offset), Ptr(ord(data^) + handlesize), len);
  353.                     HUnlock(data);
  354.                     MMungerDelete(data, offset, len);
  355.                     cacheoffset := -1;
  356.                     for j := 1 to cnt do begin
  357.                         if tmpmap^[j] > k then begin
  358.                             tmpmap^[j] := tmpmap^[j] - 1;
  359.                         end;
  360.                     end;
  361.                 end;
  362.                 MDisposePtr( tmpmap );
  363.             end;
  364.         end;
  365.         InvalidateCache;
  366.     end;
  367.  
  368.     function Collection.GetOffset (index: indexType; var offset: longint; var len: longint): boolean; { PRIVATE }
  369.         var
  370.             valid: boolean;
  371.             i: indexType;
  372.     begin
  373.         if testheap then begin
  374.             DebugStr('GetOffset;hc;g');
  375.         end;
  376.         valid := (0 < index) & (index <= cnt);
  377.         if valid then begin
  378.             if fixed then begin
  379.                 len := size;
  380.                 offset := SizeOf(header) + (index - 1) * (size + tagsize) + tagsize;
  381.             end else begin
  382.                 if (cacheoffset > 0) & (searchindex > 0) & (searchindex <= index) then begin
  383.                     offset := cacheoffset - lsize;
  384.                     i := searchindex;
  385.                 end else begin
  386.                     offset := SizeOf(header) + tagsize; { Point to first length }
  387.                     i := 1;
  388.                 end;
  389.                 while (i < index) do begin
  390.                     offset := offset + lsize + LongAtPtr(Ptr(ord(data^) + offset)) + tagsize; { Point to next length }
  391.                     i := i + 1;
  392.                 end;
  393.                 len := LongAtPtr(Ptr(ord(data^) + offset));
  394.                 offset := offset + lsize; { Point to data }
  395.             end;
  396.             cacheoffset := offset;
  397.             cachelen := len;
  398.             searchindex := index;
  399.         end else begin
  400.             Assert(false);
  401.             InvalidateCache;
  402.         end;
  403.         GetOffset := valid;
  404.     end;
  405.  
  406.     function Collection.GetTagOffset (tag: {univ } tagType; var offset: longint; var len: longint; var index: indexType; test: boolean): boolean; { PRIVATE }
  407.         var
  408.             valid: boolean;
  409.             t: tagType;
  410.             handlesize: longint;
  411.     begin
  412.         if testheap then begin
  413.             DebugStr('GetTagOffset;hc;g');
  414.         end;
  415.         valid := false;
  416.         if tagged then begin
  417.             if (cacheoffset > 0) & (searchindex < 0) & EqualTag(searchtag, tag) then begin
  418.                 offset := cacheoffset;
  419.                 len := cachelen;
  420.                 index := cacheindex;
  421.                 valid := true;
  422.             end else begin
  423.                 len := size;
  424.                 index := 0;
  425.                 offset := SizeOf(header); { Point to first tag }
  426.                 handlesize := GetHandleSize(data);
  427.                 while (not valid) & (index < cnt) do begin
  428.                     Assert((0 < offset) & (offset < handlesize));
  429.                     t := TagAtPtr(Ptr(ord(data^) + offset));
  430.                     if not fixed then begin
  431.                         len := LongAtPtr(Ptr(ord(data^) + offset + tagsize));
  432.                     end;
  433.                     offset := offset + tagsize + lensize + len; { Point to next tag }
  434.                     index := index + 1;
  435.                     valid := EqualTag(t, tag);
  436.                 end;
  437.                 offset := offset - len; { Point to data }
  438.             end;
  439.         end;
  440.         if not test then begin
  441.             Assert(valid);
  442.         end;
  443.         if valid then begin
  444.             cacheoffset := offset;
  445.             cachelen := len;
  446.             cacheindex := index;
  447.             searchindex := -1;
  448.             searchtag := tag;
  449.         end else begin
  450.             InvalidateCache;
  451.         end;
  452.         GetTagOffset := valid;
  453.     end;
  454.  
  455.     function Collection.Count: indexType;
  456.     begin
  457.         Count := cnt;
  458.     end;
  459.  
  460.     function Collection.GetTag (index: indexType): tagType;
  461.         var
  462.             offset, len: longint;
  463.     begin
  464.         GetTag := tagType(no_tag);
  465.         Assert(tagged);
  466.         if GetOffset(index, offset, len) then begin
  467.             GetTag := TagAtPtr(Ptr(ord(data^) + offset - lensize - tagsize));
  468.         end;
  469.     end;
  470.  
  471.     procedure Collection.SetTag (index: indexType; tag: tagType);
  472.         var
  473.             offset, len: longint;
  474.     begin
  475.         Assert(tagged);
  476.         if GetOffset(index, offset, len) then begin
  477.             BlockMoveData(@tag, Ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  478.         end;
  479.     end;
  480.  
  481.     function Collection.GetIndex (tag: tagType): indexType;
  482.         var
  483.             offset, len: longint;
  484.             index: indexType;
  485.     begin
  486.         GetIndex := 0;
  487.         if GetTagOffset(tag, offset, len, index, true) then begin
  488.             GetIndex := index;
  489.         end;
  490.     end;
  491.  
  492.     function Collection.Info (index: indexType; var len: longint): boolean;
  493.         var
  494.             offset: longint;
  495.     begin
  496.         Info := (1 <= index) & (index <= cnt) & GetOffset(index, offset, len);
  497.     end;
  498.  
  499.     function Collection.InfoTag (tag: {univ } tagType; var len: longint): boolean;
  500.         var
  501.             offset: longint;
  502.             index: indexType;
  503.     begin
  504.         InfoTag := GetTagOffset(tag, offset, len, index, true);
  505.     end;
  506.  
  507.     function Collection.Exists (index: indexType): boolean;
  508.         var
  509.             len: longint;
  510.     begin
  511.         Exists := Info(index, len);
  512.     end;
  513.  
  514.     function Collection.ExistsTag (tag: {univ } tagType): boolean;
  515.         var
  516.             len: longint;
  517.     begin
  518.         ExistsTag := InfoTag(tag, len);
  519.     end;
  520.  
  521.     procedure Collection.Delete (index: indexType);
  522.         var
  523.             offset, len: longint;
  524.     begin
  525.         if GetOffset(index, offset, len) then begin
  526.             MMungerDelete(data, offset - tagsize - lensize, tagsize + lensize + len);
  527.             cnt := cnt - 1;
  528.             InvalidateCache;
  529.         end;
  530.     end;
  531.  
  532.     procedure Collection.DeleteTag (tag: {univ } tagType);
  533.         var
  534.             offset, len: longint;
  535.             index: indexType;
  536.     begin
  537.         if GetTagOffset(tag, offset, len, index, true) then begin
  538.             MMungerDelete(data, offset - tagsize - lensize, tagsize + lensize + len);
  539.             cnt := cnt - 1;
  540.             InvalidateCache;
  541.         end;
  542.     end;
  543.  
  544.     procedure Collection.AddChunk (tag: tagType; p: Ptr; len: longint);
  545.         var
  546.             orgsize: longint;
  547.     begin
  548.         if testheap then begin
  549.             DebugStr('AddChunk Enter;hc;g');
  550.         end;
  551.         if error = noErr then begin
  552.             orgsize := GetHandleSize(data);
  553.             SetHandleSize(data, orgsize + tagsize + lensize + len);
  554.             if MemError = noErr then begin
  555.                 if tagged then begin
  556.                     BlockMoveData(@tag, Ptr(ord(data^) + orgsize), lsize);
  557.                     orgsize := orgsize + lsize;
  558.                 end else begin
  559.                     Assert( EqualTag(tag, tagType(no_tag)) );
  560.                 end;
  561.                 if not fixed then begin
  562.                     BlockMoveData(@len, Ptr(ord(data^) + orgsize), lsize);
  563.                     orgsize := orgsize + lsize;
  564.                 end else begin
  565.                     Assert(len = size);
  566.                 end;
  567.                 BlockMoveData(p, Ptr(ord(data^) + orgsize), len);
  568.                 cnt := cnt + 1;
  569.             end;
  570.         end;
  571.         if testheap then begin
  572.             DebugStr('AddChunk Exit;hc;g');
  573.         end;
  574.     end;
  575.  
  576.     procedure Collection.InsertBefore (index: indexType);
  577.         var
  578.             offset, len, oe: longint;
  579.             t: tagType;
  580.     begin
  581.         t := tagType(no_tag);
  582.         if index = Count + 1 then begin
  583.             if fixed then begin
  584.                 AddChunk(t, @index, size);
  585.             end else begin
  586.                 AddChunk(t, @index, 0);
  587.             end;
  588.         end else begin
  589.             if GetOffset(index, offset, len) then begin
  590.                 offset := offset - lensize - tagsize;
  591.                 if tagged then begin
  592.                     oe := MMungerInsert(data, offset, @t, tagsize);
  593.                     offset := offset + tagsize;
  594.                 end;
  595.                 if fixed then begin
  596.                     oe := MMungerInsert(data, offset, @index, size);
  597.                 end else begin
  598.                     len := 0;
  599.                     oe := MMungerInsert(data, offset, @len, lensize);
  600.                 end;
  601.                 if error = noErr then begin
  602.                     error := MemError;
  603.                 end;
  604.                 cnt := cnt + 1;
  605.                 InvalidateCache;
  606.             end;
  607.         end;
  608.     end;
  609.  
  610.     procedure Collection.SetChunk (offset, l: longint; tag: tagType; p: Ptr; len: longint);
  611.     begin
  612.         if tagged then begin
  613.             BlockMoveData(@tag, Ptr(ord(data^) + offset - lensize - tagsize), tagsize);
  614.         end else begin
  615.             Assert( EqualTag(tag, tagType(no_tag)) );
  616.         end;
  617.         if fixed then begin
  618.             Assert(len = size);
  619.         end;
  620.         if l = len then begin
  621.             BlockMoveData(p, Ptr(ord(data^) + offset), len);
  622.         end else begin
  623.             BlockMoveData(@len, Ptr(ord(data^) + offset - lensize), lensize);
  624.             offset := Munger(data, offset, nil, l, p, len);
  625.             if error = noErr then begin
  626.                 error := MemError;
  627.             end;
  628.         end;
  629.         InvalidateCache;
  630.     end;
  631.  
  632.     procedure Collection.SetChunkIndex (index: indexType; p: Ptr; len: longint);
  633.         var
  634.             offset, l: longint;
  635.     begin
  636.         if GetOffset(index, offset, l) then begin
  637.             SetChunk(offset, l, tagType(no_tag), p, len);
  638.         end;
  639.     end;
  640.  
  641.     procedure Collection.SetChunkTag (tag: tagType; p: Ptr; len: longint);
  642.         var
  643.             offset, l: longint;
  644.             index: indexType;
  645.     begin
  646.         if GetTagOffset(tag, offset, l, index, true) then begin
  647.             SetChunk(offset, l, tag, p, len);
  648.         end else begin
  649.             AddChunk(tag, p, len);
  650.         end;
  651.     end;
  652.  
  653.     procedure Collection.GetChunkIndex (index: indexType; len: longint; p: Ptr);
  654.         var
  655.             offset, l: longint;
  656.     begin
  657.         if GetOffset(index, offset, l) then begin
  658.             Assert(l = len);
  659.             BlockMoveData(Ptr(ord(data^) + offset), p, len);
  660.         end;
  661.     end;
  662.  
  663.     procedure Collection.GetChunkTag (tag: tagType; len: longint; p: Ptr);
  664.         var
  665.             offset, l: longint;
  666.             index: indexType;
  667.     begin
  668.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  669.             Assert(l = len);
  670.             BlockMoveData(Ptr(ord(data^) + offset), p, len);
  671.         end else begin
  672.             MZero(p, len);
  673.         end;
  674.     end;
  675.  
  676.     procedure Collection.AddBoolean (b: boolean);
  677.         var
  678.             n: integer;
  679.     begin
  680.         n := -ord(b);
  681.         AddChunk(tagType(no_tag), @n, 1);
  682.     end;
  683.  
  684.     procedure Collection.AddTagBoolean (tag: {univ } tagType; b: boolean);
  685.         var
  686.             n: integer;
  687.     begin
  688.         n := -ord(b);
  689.         AddChunk(tag, @n, 1);
  690.     end;
  691.  
  692.     procedure Collection.AddLong (n: univ longint);
  693.     begin
  694.         AddChunk(tagType(no_tag), @n, lsize);
  695.     end;
  696.  
  697.     procedure Collection.AddTagLong (tag: {univ } tagType; n: univ longint);
  698.     begin
  699.         AddChunk(tag, @n, lsize);
  700.     end;
  701.  
  702.     procedure Collection.AddString (const s: Str255);
  703.     begin
  704.         AddChunk(tagType(no_tag), @s[1], length(s));
  705.     end;
  706.  
  707.     procedure Collection.AddTagString (tag: {univ } tagType; const s: Str255);
  708.     begin
  709.         AddChunk(tag, @s[1], length(s));
  710.     end;
  711.  
  712.     procedure Collection.AddData (p: Ptr; len: longint);
  713.     begin
  714.         AddChunk(tagType(no_tag), p, len);
  715.     end;
  716.  
  717.     procedure Collection.AddTagData (tag: {univ } tagType; p: Ptr; len: longint);
  718.     begin
  719.         AddChunk(tag, p, len);
  720.     end;
  721.  
  722.     procedure Collection.AddItem (p: Ptr);
  723.     begin
  724.         AddChunk(tagType(no_tag), p, size);
  725.     end;
  726.  
  727.     procedure Collection.AddTagItem (tag: {univ } tagType; p: Ptr);
  728.     begin
  729.         AddChunk(tag, p, size);
  730.     end;
  731.  
  732.     procedure Collection.SetBoolean (index: indexType; b: boolean);
  733.         var
  734.             n: integer;
  735.     begin
  736.         n := -ord(b);
  737.         SetChunkIndex(index, @n, 1);
  738.     end;
  739.  
  740.     procedure Collection.SetTagBoolean (tag: {univ } tagType; b: boolean);
  741.         var
  742.             n: integer;
  743.     begin
  744.         n := -ord(b);
  745.         SetChunkTag(tag, @n, 1);
  746.     end;
  747.  
  748.     procedure Collection.SetLong (index: indexType; n: univ longint);
  749.     begin
  750.         SetChunkIndex(index, @n, lsize);
  751.     end;
  752.  
  753.     procedure Collection.SetTagLong (tag: {univ } tagType; n: univ longint);
  754.     begin
  755.         SetChunkTag(tag, @n, lsize);
  756.     end;
  757.  
  758.     procedure Collection.SetString (index: indexType; const s: Str255);
  759.     begin
  760.         SetChunkIndex(index, @s[1], length(s));
  761.     end;
  762.  
  763.     procedure Collection.SetTagString (tag: {univ } tagType; const s: Str255);
  764.     begin
  765.         SetChunkTag(tag, @s[1], length(s));
  766.     end;
  767.  
  768.     procedure Collection.SetData (index: indexType; p: Ptr; len: longint);
  769.     begin
  770.         SetChunkIndex(index, p, len);
  771.     end;
  772.  
  773.     procedure Collection.SetTagData (tag: {univ } tagType; p: Ptr; len: longint);
  774.     begin
  775.         SetChunkTag(tag, p, len);
  776.     end;
  777.  
  778.     procedure Collection.SetItem (index: indexType; p: Ptr);
  779.     begin
  780.         SetChunkIndex(index, p, size);
  781.     end;
  782.  
  783.     procedure Collection.SetTagItem (tag: {univ } tagType; p: Ptr);
  784.     begin
  785.         SetChunkTag(tag, p, size);
  786.     end;
  787.  
  788.     function Collection.GetBoolean (index: indexType): boolean;
  789.         var
  790.             n: integer;
  791.     begin
  792.         n := 0;
  793.         GetChunkIndex(index, 1, @n);
  794.         GetBoolean := n <> 0;
  795.     end;
  796.  
  797.     function Collection.GetTagBoolean (tag: {univ } tagType): boolean;
  798.         var
  799.             n: integer;
  800.     begin
  801.         n := 0;
  802.         GetChunkTag(tag, 1, @n);
  803.         GetTagBoolean := n <> 0;
  804.     end;
  805.  
  806.     procedure Collection.GetLong (index: indexType; var l: univ longint);
  807.     begin
  808.         GetChunkIndex(index, 4, @l);
  809.     end;
  810.  
  811.     procedure Collection.GetTagLong (tag: {univ } tagType; var l: univ longint);
  812.     begin
  813.         GetChunkTag(tag, 4, @l);
  814.     end;
  815.  
  816.     function Collection.GetString (index: indexType): Str255;
  817.         var
  818.             offset, l: longint;
  819.             s: Str255;
  820.     begin
  821.         s := '';
  822.         if GetOffset(index, offset, l) then begin
  823.             Assert(l <= 255);
  824.             BlockMoveData(Ptr(ord(data^) + offset), @s[1], l);
  825.             s[0] := chr(l);
  826.         end;
  827.         GetString := s;
  828.     end;
  829.  
  830.     function Collection.GetTagString (tag: {univ } tagType): Str255;
  831.         var
  832.             offset, l: longint;
  833.             index: indexType;
  834.             s: Str255;
  835.     begin
  836.         s := '';
  837.         if GetTagOffset(tag, offset, l, index, safeget) then begin
  838.             Assert(l <= 255);
  839.             BlockMoveData(Ptr(ord(data^) + offset), @s[1], l);
  840.             s[0] := chr(l);
  841.         end;
  842.         GetTagString := s;
  843.     end;
  844.  
  845.     procedure Collection.GetData (index: indexType; p: Ptr; len: longint);
  846.     begin
  847.         GetChunkIndex(index, len, p);
  848.     end;
  849.  
  850.     procedure Collection.GetTagData (tag: {univ } tagType; p: Ptr; len: longint);
  851.     begin
  852.         GetChunkTag(tag, len, p);
  853.     end;
  854.  
  855.     procedure Collection.GetItem (index: indexType; p: Ptr);
  856.     begin
  857.         GetChunkIndex(index, size, p);
  858.     end;
  859.  
  860.     procedure Collection.GetTagItem (tag: {univ } tagType; p: Ptr);
  861.     begin
  862.         GetChunkTag(tag, size, p);
  863.     end;
  864.  
  865. end.